MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 05 - 1989/05.06 Jun 89/LOC Source/Test Source/PopMenuCDEF.p

Text File | 1988-09-28 | 26.4 KB | 1,199 lines | [TEXT/MPS ]

(*****************************************************
PopMenuCDEF.p
   This file contains the Pascal source code for the
   routines needed to implement the pop-up menu
   button CDEF described (in passing) in Inside Mac,
   v5, p242.
*****************************************************)

UNIT PopMenuCDEF;

INTERFACE
USES
    {$U MemTypes.p    }    MemTypes,
    {$U QuickDraw.p    }    QuickDraw,
    {$U OSIntf.p        }    OSIntf,
    {$U ToolIntf.p        }    ToolIntf,
    {$U PopMenuIntf.p    }    PopMenuIntf;


FUNCTION MyControl(varCode: INTEGER;
                   theCntl: ControlHandle;
                   message: INTEGER;
                   param: LONGINT): LONGINT;


IMPLEMENTATION
CONST
    VISIBLE        =    255;
    INVISIBLE        =      0;
    INACTIVE        =    255;
    ACTIVE        =      0;
    DRAW_ALL    =      0;
    NOT_IN_CTL    =      0;
    L_PIXELS        =     13;
    GREY            =     16;
    PARENT        =    $1B;


TYPE
    CtlDataRec    = record
        popMenu:        MenuHandle;
        menuProcID:    INTEGER;
        hasColorQD:    Boolean;
        markChar:        Char;
        wFgColor:        RGBColor;
        wBgColor:        RGBColor;
        wContColor:    RGBColor;
        mTitleColor:    RGBColor;
        mBgColor:        RGBColor;
        iNameColor:    RGBColor;
        iKeyColor:        RGBColor;
    end;
    CtlDataPtr    =    ^CtlDataRec;
    CtlDataHdl    =    ^CtlDataPtr;

    StateRec = record
        savePort:    GrafPtr;
        savePen:    PenState;
        oldClip:        RgnHandle;
        newClip:    RgnHandle;
    end;


(*****************************************************
forward declarations
*****************************************************)

PROCEDURE    doDrawCntl(theCntl: ControlHandle;
                vcLong, param: LONGINT);
                forward;
FUNCTION        doTestCntl(theCntl: ControlHandle;
                param: LONGINT): LONGINT;
                forward;
PROCEDURE    doCalcCRgns(theCntl: ControlHandle;
                param: LONGINT);
                forward;
PROCEDURE    doInitCntl(theCntl: ControlHandle;
                vcLong: LONGINT);
                forward;
PROCEDURE    doDispCntl(theCntl: ControlHandle;
                vcLong: LONGINT);
                forward;
PROCEDURE    doAutoTrack(theCntl: ControlHandle;
                vcLong, param: LONGINT);
                forward;


(*****************************************************
MyControl: Main entry point.  Call appropriate
    message-handling routine.
*****************************************************)

FUNCTION MyControl(varCode: INTEGER;
            theCntl: ControlHandle;
            message: INTEGER;
            param: LONGINT): LONGINT;
VAR
    vcLong:        LONGINT;

BEGIN
    MyControl := 0;
    vcLong := Ord4(varCode);

    CASE message OF
        drawCntl:
            doDrawCntl(theCntl, vcLong, param);
        testCntl:
            MyControl := doTestCntl(theCntl, param);
        calcCRgns:
            doCalcCRgns(theCntl, param);
        initCntl:
            doInitCntl(theCntl, vcLong);
        dispCntl:
            doDispCntl(theCntl, vcLong);
        autoTrack:
            doAutoTrack(theCntl, vcLong, param);
    END;  { case }
END;  { MyControl }



(*****************************************************
CallMDEF: Calls the given ProcPtr, passing it the
    given parameters.
*****************************************************)

PROCEDURE CallMDEF(message: INTEGER;
                theMenu: MenuHandle;
                menuRect: Rect;
                hitPt: Point;
                whichItem: INTEGER;
                MDEFProc: ProcPtr);
Inline
    $205F,     { move.l (sp)+, a0    ; get address of proc    }
    $4E90;     { jsr (a0)            ; call the proc            }



(*****************************************************
GetItemRect: Get the given item's rectangle.
*****************************************************)

PROCEDURE GetItemRect(theCntl: ControlHandle;
                            menuID: INTEGER;
                            menuItem: INTEGER;
                            VAR boxRect: Rect);
VAR
    hitPt:            Point;
    menuHdl:        MenuHandle;
    mDefProc:        Handle;

BEGIN
    SetPt(hitPt, 0, 0);
    menuHdl := GetMHandle(menuID);
    mDefProc := menuHdl^^.menuProc;
    LoadResource(mDefProc);

    CallMDEF(mItemRectMsg,
            menuHdl,
            boxRect,
            hitPt,
            menuItem,
            ProcPtr(mDefProc^));
END;  { GetItemRect }



(*****************************************************
DrawMenuItem: Draw the given menu item in the
    given rectangle.
*****************************************************)

PROCEDURE DrawMenuItem(theCntl: ControlHandle;
                            menuID: INTEGER;
                            menuItem: INTEGER;
                            boxRect: Rect);
VAR
    hitPt:            Point;
    menuHdl:        MenuHandle;
    mDefProc:        Handle;

BEGIN
    SetPt(hitPt, 0, 0);
    menuHdl := GetMHandle(menuID);
    mDefProc := menuHdl^^.menuProc;
    LoadResource(mDefProc);

    CallMDEF(mDrawItemMsg,
            menuHdl,
            boxRect,
            hitPt,
            menuItem,
            ProcPtr(mDefProc^));
END;  { DrawMenuItem }




(*****************************************************
GetContentColor: Get the window's content color.
*****************************************************)

PROCEDURE GetContentColor(wPtr: WindowPtr;
            VAR contColor: RGBColor);
VAR
    auxWinHdl:    AuxWinHndl;
    winCTable:    WCTabHandle;
    b_ignore:    Boolean;
    i:            INTEGER;

BEGIN
    b_ignore := GetAuxWin(wPtr, auxWinHdl);
    winCTable := WCTabHandle(auxWinHdl^^.
                                    awCTable);

    i := winCTable^^.ctSize;

    { search for wContentColor }
    while ((i >= 0) and (winCTable^^.ctTable[i].value
                        <> wContentColor)) do begin
        i := i - 1;
    end;

    { if we didn't find it, default to first entry }
    if (i < 0) then
        i := 0;

    contColor := winCTable^^.ctTable[i].rgb;
END;  { GetContentColor }



(*****************************************************
GetMenuColors: Initialize the control's menu color
    information.  ctlData must be locked before calling
    this routine.
*****************************************************)

PROCEDURE GetMenuColors(theCntl: ControlHandle;
            ctlData: CtlDataHdl);
VAR
    WhiteRGB:    RGBColor;
    BlackRGB:    RGBColor;
    mbarPtr:    MCEntryPtr;
    titlePtr:        MCEntryPtr;
    itemPtr:    MCEntryPtr;

BEGIN
    { default colors }
    WhiteRGB.red   := $FFFF;
    WhiteRGB.green := $FFFF;
    WhiteRGB.blue  := $FFFF;
    BlackRGB.red   := 0;
    BlackRGB.green := 0;
    BlackRGB.blue  := 0;

    with theCntl^^ do begin
        mbarPtr  := GetMCEntry(0, 0);
        titlePtr := GetMCEntry(contrlMax, 0);
        itemPtr  := GetMCEntry(contrlMax, contrlMin);
    end;

    { get defaults from mbar, or default to B&W }
    with ctlData^^ do begin
        if (mbarPtr = NIL) then
            begin
                if (titlePtr = NIL) then begin
                    mTitleColor := BlackRGB;
                    mBgColor    := WhiteRGB;
                end;

                if (itemPtr = NIL) then begin
                    iNameColor  := BlackRGB;
                    iKeyColor   := BlackRGB;
                end;
            end
        else if (titlePtr = NIL) then begin
            mTitleColor := mbarPtr^.mctRGB1;
            mBgColor    := mbarPtr^.mctRGB2;

            if (itemPtr = NIL) then begin
                iNameColor  := mbarPtr^.mctRGB3;
                iKeyColor   := mbarPtr^.mctRGB3;
            end;
        end;

        { get colors and defaults from the title entry }
        if (titlePtr <> NIL) then begin
            mTitleColor := titlePtr^.mctRGB1;
            mBgColor     := titlePtr^.mctRGB4;

            if (itemPtr = NIL) then begin
                iNameColor := titlePtr^.mctRGB3;
                iKeyColor  := titlePtr^.mctRGB3;
            end;
        end;

        { set the item colors }
        if (itemPtr <> NIL) then begin
            iNameColor := itemPtr^.mctRGB2;
            iKeyColor  := itemPtr^.mctRGB3;
        end;
    end;  { with ctlData^^ }
END;  { GetMenuColors }



(*****************************************************
InitColorInfo: Initialize the control's color information.
*****************************************************)

PROCEDURE InitColorInfo(theCntl: ControlHandle;
            ctlData: CtlDataHdl);
VAR
    i:            INTEGER;
    wPtr:        WindowPtr;

BEGIN
    HLock(Handle(ctlData));

    with ctlData^^ do begin
        wPtr := theCntl^^.contrlOwner;

        { get the window's content color }
        GetContentColor(wPtr, wContColor);

        { save the window's current fg and bg colors }
        GetForeColor(wFgColor);
        GetBackColor(wBgColor);

        { get the menu's and current item's colors }
        GetMenuColors(theCntl, ctlData);
    end;

    HUnlock(Handle(ctlData));
END;  { InitColorInfo }




(*****************************************************
GetTitleRect: Get the title of the pop-up menu.
*****************************************************)

PROCEDURE GetTitleRect(theCntl: ControlHandle;
            VAR titleRect: Rect);
VAR
    fInfo:    FontInfo;
    height:    INTEGER;

BEGIN
    GetFontInfo(fInfo);

    with fInfo do begin
        height := ascent + descent + leading;
    end;

    { define the title's rect }
    with theCntl^^ do begin
        SetRect(titleRect, contrlRect.left,
                           contrlRect.top,
                           contrlRect.left +
                               StringWidth(contrlTitle),
                           contrlRect.top + height);

        with titleRect do begin
            if (bottom > contrlRect.bottom - 1) then
                bottom := contrlRect.bottom - 1;

            if (right > contrlRect.right - 1) then
                right := contrlRect.right - 1;
        end;  { with titleRect }
    end;  { with theCntl^^ }
END;  { GetTitleRect }




(*****************************************************
GetBoxRect: Get the box surrounding the pop-up
    box.
*****************************************************)

PROCEDURE GetBoxRect(theCntl: ControlHandle;
            VAR boxRect: Rect);
VAR
    leftEdge:        INTEGER;
    popMenu:        MenuHandle;
    fInfo:            FontInfo;
    height:            INTEGER;
    menuProcID:    INTEGER;
    ctlData:        CtlDataHdl;

BEGIN
    ctlData := CtlDataHdl(theCntl^^.contrlData);
    menuProcID := ctlData^^.menuProcID;

    if (menuProcID = textMenuProc) then
        begin
            GetFontInfo(fInfo);

            with fInfo do begin
                height := ascent + descent + leading;
            end;

            with theCntl^^ do begin
                { find the left edge of the pop-up box }
                leftEdge := contrlRect.left +
                            StringWidth(contrlTitle);

                popMenu := ctlData^^.popMenu;

                { defend against Menu Manager bug }
                CalcMenuSize(popMenu);

                { define the pop-up box's rect }
                SetRect(boxRect,
                        leftEdge,
                         contrlRect.top,
                         leftEdge +
                             popMenu^^.menuWidth +
                            2,
                        contrlRect.top + height + 1);
            end;  { with theCntl^^ }
        end  { menuProc = nil }
    else begin
        GetItemRect(theCntl,
                    theCntl^^.contrlMax,
                    theCntl^^.contrlMin,
                    boxRect);
    end;  { else }

    with theCntl^^ do begin
        with boxRect do begin
            if (bottom > contrlRect.bottom - 1) then
                bottom := contrlRect.bottom - 1;

            if (right > contrlRect.right - 1) then
                right := contrlRect.right - 1;
        end;  { with boxRect }
    end;  { with theCntl^^ }
END;  { GetBoxRect }




(*****************************************************
GetCtlRect: Get the box surrounding the pop-up box
    and its title.
*****************************************************)

PROCEDURE GetCtlRect(theCntl: ControlHandle;
            VAR ctlRect: Rect);
VAR
    boxRect:    Rect;
    titleRect:    Rect;

BEGIN
    GetBoxRect(theCntl, boxRect);
    GetTitleRect(theCntl, titleRect);

    UnionRect(boxRect, titleRect, ctlRect);

    with ctlRect do begin
        SetRect(ctlRect, left, top,
            right + 1, bottom + 1);
    end;
END;  { GetCtlRect }




(*****************************************************
InstallMenus: Recursive routine to install a menu and
    its sub-menus, if any.  It is only called once
    (from doInitCntl()).
*****************************************************)

PROCEDURE InstallMenus(rsrcID: INTEGER);
VAR
    mh:    MenuHandle;
    ni:        INTEGER;
    i:        INTEGER;
    c:        Char;

BEGIN
    mh := GetMenu(rsrcID);
    InsertMenu(mh, -1);
    ni := CountMItems(mh);

    { look for parent items }
    for i := 1 to ni do begin
        GetItemCmd(mh, i, c);

        { if it's a parent item, recurse on its child }
        if (c = CHR(PARENT)) then begin
            GetItemMark(mh, i, c);
            InstallMenus(ORD(c));
        end;
    end;
END;  { InstallMenus }




(*****************************************************
RemoveMenus: Recursive routine to remove a menu
    and its sub-menus, if any.  It is only called once
    (from doDispCntl()).
*****************************************************)

PROCEDURE RemoveMenus(menuID: INTEGER);
VAR
    mh:    MenuHandle;
    ni:        INTEGER;
    i:        INTEGER;
    c:        Char;

BEGIN
    mh := GetMHandle(menuID);
    ni := CountMItems(mh);

    { look for parent items }
    for i := 1 to ni do begin
        GetItemCmd(mh, i, c);

        { if it's a parent item, recurse on its child }
        if (c = CHR(PARENT)) then begin
            GetItemMark(mh, i, c);
            RemoveMenus(ORD(c));
        end;
    end;

    { delete the menu from the menu list }
    DeleteMenu(menuID);
    ReleaseResource(Handle(mh));
END;  { RemoveMenus }




(*****************************************************
ShrinkString: Make the given string fit in the given
    box.  From a program by Bryan Stearns.
*****************************************************)

PROCEDURE ShrinkString(VAR s: Str255; r: Rect);
VAR
    s_pix:    INTEGER;
    s_len:    INTEGER;
    room:    INTEGER;

BEGIN
    { how much room do we have? }
    room := (r.right - r.left) - L_PIXELS;

    { watch for weirdness }
    if (room < 0) then begin
        room := 0;
        s[0] := CHR(0);
    end;

    { get the width of the string }
    s_pix := StringWidth(s);

    { will it fit? }
    if (s_pix > room) then begin
        s_len := LENGTH(s);
        room := room - CharWidth('…');

        repeat
            s_pix := s_pix - CharWidth(s[s_len]);
            s_len := s_len - 1;
        until ((s_pix < room) or (LENGTH(s) = 0));

        s_len := s_len + 1;
        s[s_len] := '…';
        s[0] := CHR(s_len);
    end;
END;  { ShrinkString }




(*****************************************************
DrawTitle: Draw the title of the pop-up menu control.
*****************************************************)

PROCEDURE DrawTitle(theCntl: ControlHandle);
VAR
    titleRect:    Rect;
    ctlData:    CtlDataHdl;
    fInfo:        FontInfo;
    baseline:    INTEGER;

BEGIN
    with theCntl^^ do begin
        ctlData := CtlDataHdl(contrlData);

        { if we need to draw in color, set the colors }
        with ctlData^^ do begin
            if (hasColorQD) then begin
                if (contrlHilite = titlePart) then
                    begin
                        RGBForeColor(wContColor);
                        RGBBackColor(mTitleColor);
                    end
                else begin
                    RGBForeColor(mTitleColor);
                    RGBBackColor(wContColor);
                end;
            end;
        end;

        { get the control's title box, and erase it }
        GetTitleRect(theCntl, titleRect);
        EraseRect(titleRect);

        { get info about the current font }
        GetFontInfo(fInfo);

        { define baseline }
        with fInfo do begin
            baseline := contrlRect.top + ascent;
        end;

        { move to baseline }
        MoveTo(titleRect.left + 1, baseline);

        { draw control title (= the pop-up menu's title) }
        DrawString(contrlTitle);

        { if we drew in color, restore the colors }
        with ctlData^^ do begin
            if (hasColorQD) then
                begin
                    RGBForeColor(wFgColor);
                    RGBBackColor(wBgColor);
                end
            else if (contrlHilite = titlePart) then begin
                InvertRect(titleRect);
            end;
        end;
    end;
END;  { DrawTitle }





(*****************************************************
DrawDropShadow: Draw the shadow around the
    pop-up box of the pop-up menu control.
*****************************************************)

PROCEDURE DrawDropShadow(
                            theCntl: ControlHandle;
                            boxRect: Rect);
VAR
    ctlData:    CtlDataHdl;

BEGIN
    ctlData := CtlDataHdl(theCntl^^.contrlData);

    { if we need to draw in color, set the colors }
    with ctlData^^ do begin
        if (hasColorQD) then begin
            RGBForeColor(mTitleColor);
            RGBBackColor(mBgColor);
        end;  { if }
    end; { with ctlData^^ }

    with boxRect do begin
        { draw the drop shadow }
        MoveTo(right, top + 2);
        LineTo(right, bottom);
        LineTo(left + 2, bottom);
    end;  { with boxRect }

    { if we drew in color, restore the colors }
    with ctlData^^ do begin
        if (hasColorQD) then begin
            RGBForeColor(wFgColor);
            RGBBackColor(wBgColor);
        end;  { if }
    end;  { with ctlData^^ }
END;  { DrawDropShadow }





(*****************************************************
DrawPopBox: Draw the pop-up box of the pop-up
    menu control.  Also draws drop shadow.
*****************************************************)

PROCEDURE DrawPopBox(theCntl: ControlHandle;
                            vcLong: LONGINT);
VAR
    boxRect:        Rect;
    itemStr:        Str255;
    ctlData:        CtlDataHdl;
    fInfo:            FontInfo;
    baseline:        INTEGER;
    menuProcID:    INTEGER;

BEGIN
    ctlData := CtlDataHdl(theCntl^^.contrlData);
    menuProcID := ctlData^^.menuProcID;

    if (menuProcID = textMenuProc) then
        begin { standard textMenuProc }
            with theCntl^^ do begin
                ctlData := CtlDataHdl(contrlData);
                GetBoxRect(theCntl, boxRect);

                { erase the box and shadow }
                with boxRect do begin
                    SetPt(botRight, right + 2,
                                    bottom + 2);
                    EraseRect(boxRect);
                    SetPt(botRight, right - 2,
                                    bottom - 2);
                end;  { with }

                { get current selection string }
                GetItem(GetMHandle(contrlMax),
                                    contrlMin,
                                    itemStr);

                { make the string fit in the boxRect }
                ShrinkString(itemStr, boxRect);

                { if color, set the colors }
                with ctlData^^ do begin
                    if (hasColorQD) then begin
                      RGBForeColor(mTitleColor);
                      RGBBackColor(mBgColor);
                    end;
                end;

                { frame the box }
                FrameRect(boxRect);

                { get info about the current font }
                GetFontInfo(fInfo);

                { define baseline }
                with fInfo do begin
                    baseline := contrlRect.top +
                                    ascent;
                end;

                { if color, set the colors }
                with ctlData^^ do begin
                    if (hasColorQD) then begin
                      RGBForeColor(iNameColor);
                    end;
                end;


                with boxRect do begin
                    { draw the string in the popup box }
                    MoveTo(left+L_PIXELS, baseline);
                    DrawString(itemStr);
                end;  { with boxRect }

                { if color, restore the colors }
                with ctlData^^ do begin
                    if (hasColorQD) then begin
                        RGBForeColor(wFgColor);
                        RGBBackColor(wBgColor);
                    end;
                end;
            end;  { with theCntl^^ }
        end
    else begin { non-standard menuProc }
        GetBoxRect(theCntl, boxRect);
        DrawMenuItem(theCntl,
                    theCntl^^.contrlMax,
                    theCntl^^.contrlMin,
                    boxRect);
    end;

    DrawDropShadow(theCntl, boxRect);
END;  { DrawPopBox }



(*****************************************************
DrawDisabled: Invert the pop-up menu control's title.
*****************************************************)

PROCEDURE DrawDisabled(theCntl: ControlHandle);
VAR
    greyPat:    PatHandle;
    ctlRect:    Rect;

BEGIN
    { get the grey pattern from the System file }
    greyPat:=PatHandle(GetResource('PAT ',GREY));
    PenPat(greyPat^^);
    ReleaseResource(Handle(greyPat));

    { set the pen mode }
    PenMode(patBic);

    GetCtlRect(theCntl, ctlRect);
    PaintRect(ctlRect);
END;  { DrawDisabled }



(*****************************************************
SaveState: Save the current drawing environment.
*****************************************************)

PROCEDURE SaveState(theCntl: ControlHandle;
            VAR theState: StateRec);
VAR
    ctlData:    CtlDataHdl;

BEGIN
    { lock the control handle }
    HLock(Handle(theCntl));

    with theCntl^^ do begin
        with theState do begin
            { save current grafPort; set to owner }
            GetPort(savePort);
            SetPort(contrlOwner);

            { allocate space for clipping regions }
            oldClip := NewRgn;
            newClip := NewRgn;

            { save old clipping region }
            GetClip(oldClip);

            { set newClip region to given rectangle }
            RectRgn(newClip, contrlRect);

            { newClip: intersection of rect and region }
            SectRgn(oldClip, newClip, newClip);

            { set grafPorts' clip region to the result  }
            SetClip(newClip);

            { save current pen state; normalize pen }
            GetPenState(savePen);
            PenNormal;

            { if we have color, get the menu color info }
            ctlData := CtlDataHdl(contrlData);
            if (ctlData^^.hasColorQD) then begin
                HLock(Handle(ctlData));
                  GetMenuColors(theCntl, ctlData);
                HUnlock(Handle(ctlData));
            end;
        end;  { with theState }
    end;  { with theCntl^^ }

    { unlock the control handle }
    HUnlock(Handle(theCntl));
END;  { SaveState }



(*****************************************************
RestoreState: Restore the saved drawing environment.
*****************************************************)

PROCEDURE RestoreState(theCntl: ControlHandle;
            VAR theState: StateRec);
BEGIN
    with theState do begin
        { restore saved states }
        SetClip(oldClip);
        SetPenState(savePen);
        SetPort(savePort);

        { dispose of regions }
        DisposeRgn(oldClip);
        DisposeRgn(newClip);
    end;  { with }
END;  { RestoreState }



(*****************************************************
doDrawCntl: Draw the pop-up menu box and title.
*****************************************************)

PROCEDURE doDrawCntl(theCntl: ControlHandle;
            vcLong, param: LONGINT);
VAR
    theState:    StateRec;

BEGIN
    if (theCntl^^.contrlVis = VISIBLE) then begin
        { save the current drawing environment }
        SaveState(theCntl, theState);

        { lock the control }
        HLock(Handle(theCntl));

        { draw the control }
        DrawTitle(theCntl);
        DrawPopBox(theCntl, vcLong);

        { if inactive, grey out the control }
        if (theCntl^^.contrlHilite=INACTIVE) then begin
            DrawDisabled(theCntl);
        end;

        { unlock the control }
        HUnlock(Handle(theCntl));

        { restore the saved drawing environment }
        RestoreState(theCntl, theState);
    end;  { if VISIBLE }
END;  { doDrawCntl }




(*****************************************************
doTestCntl: Determine in which part of the control (if
    any) the given point (in 'param') lies.
*****************************************************)

FUNCTION doTestCntl(theCntl: ControlHandle;
            param: LONGINT): LONGINT;
VAR
    boxRect:    Rect;

BEGIN
    if (theCntl^^.contrlHilite <> INACTIVE) then
        begin  { control is active }
            GetBoxRect(theCntl, boxRect);

            if PtInRect(Point(param), boxRect) then
                doTestCntl := inPopUpBox
            else
                doTestCntl := NOT_IN_CTL;
        end
    else  { control is inactive }
        doTestCntl := NOT_IN_CTL;
END;  { doTestCntl }




(*****************************************************
doCalcCRgns: Calculate the region the control
    occupies in its window.
*****************************************************)

PROCEDURE doCalcCRgns(theCntl: ControlHandle;
            param: LONGINT);
VAR
    boxRect:    Rect;

BEGIN
    if (BitAnd(param, $80000000) = $80000000) then
        begin { wants indicator region - we have none }
            param := BitAnd(param, $0FFFFFFF);
            SetEmptyRgn(RgnHandle(param));
        end
    else begin
        param := BitAnd(param, $0FFFFFFF);

        { set the given region to boxRect }
        GetBoxRect(theCntl, boxRect);
        RectRgn(RgnHandle(param), boxRect);
    end;
END;  { doCalcCRgns }




(*****************************************************
doInitCntl: Do any initialization required for the given
    control.
*****************************************************)

PROCEDURE doInitCntl(theCntl: ControlHandle;
            vcLong: LONGINT);
VAR
    popMenu:        MenuHandle;
    dfltMenu:        MenuHandle;
    ctlRect:        Rect;
    ctlData:        CtlDataHdl;
    world:            SysEnvRec;
    error:            OSErr;
    markChar:        Char;
    menuProcID:    INTEGER;

BEGIN
    { lock the control record down  }
    HLock(Handle(theCntl));

    with theCntl^^ do begin
        { allocate a relocatable block }
        ctlData := CtlDataHdl(NewHandle(sizeof(
                                    CtlDataRec)));

        { is color QuickDraw running? }
        error := SysEnvirons(1, world);
        ctlData^^.hasColorQD := world.hasColorQD;

        { store a handle to the control data  }
        contrlData := Handle(ctlData);

        { erase the control's rectangle }
        EraseRect(contrlRect);

        { get a handle to the 'MENU' resource }
        popMenu := MenuHandle(
                        GetResource('MENU',
                                        contrlValue));

        { save the menuProc ID }
        ctlData^^.menuProcID := HiWord(
                        Ord4(popMenu^^.menuProc));

        { load pop-up menu, and its sub-menus }
        InstallMenus(contrlValue);
        popMenu := GetMHandle(contrlValue);

        { save the pop-up menu's menu handle }
        ctlData^^.popMenu := popMenu;

        { append resource names to the menu? }
        if ((BitAnd(vcLong, mRes) = mRes) and
                (contrlRfCon <> 0)) then begin
            AddResMenu(popMenu,
                        OSType(contrlRfCon));
        end;

        { does the user want to use a check mark? }
        if (BitAnd(vcLong,mCheck)=mCheck) then begin
            { get a handle to the default menu }
            dfltMenu := GetMHandle(contrlMax);

            IF (CountMItems(dfltMenu) >= contrlMin) THEN
                BEGIN
                { get the default menu item's mark char }
                GetItemMark(dfltMenu, contrlMin, markChar);

                { if no mark char, default to checkMark }
                if (markChar = CHR(noMark)) then
                    BEGIN
                    markChar := CHR(checkMark);

                    { set the default item's mark }
                    SetItemMark(dfltMenu, contrlMin, markChar);
                    END;
                END
             ELSE BEGIN
                markChar := CHR(checkMark);
            END;

            { save the mark character }
            ctlData^^.markChar := markChar;
        end;

        { if we have color, initialize the color info }
        if (world.hasColorQD) then begin
            InitColorInfo(theCntl, ctlData);
        end;

        { flag the default action proc }
        contrlAction := POINTER(-1);
    end;  { with theCntl }

    { unlock the control record before SetCTitle }
    HUnlock(Handle(theCntl));
END;  { doInitCntl }




(*****************************************************
doDispCntl: Do any de-allocation required for the
    given control.
*****************************************************)

PROCEDURE doDispCntl(theCntl: ControlHandle;
            vcLong: LONGINT);
VAR
    popMenu:    MenuHandle;
    ctlData:    CtlDataHdl;

BEGIN
    ctlData := CtlDataHdl(theCntl^^.contrlData);
    popMenu := ctlData^^.popMenu;

    { remove the pop-up and its sub-menus }
    RemoveMenus(popMenu^^.menuID);
END;  { doDispCntl }




(*****************************************************
doAutoTrack: This is the default action procedure for
    all controls of this type.  TrackControl() will
    place the value inPopBox in contrlHilite
    before calling doAutoTrack, so the old
    value will be lost before we can save it here.
*****************************************************)

PROCEDURE doAutoTrack(theCntl: ControlHandle;
            vcLong, param: LONGINT);
VAR
    popMenu:        MenuHandle;
    menuResult:    LONGINT;
    menuID:        INTEGER;
    menuItem:        INTEGER;
    boxRect:        Rect;
    globalPt:        Point;
    default:        INTEGER;
    saveTable:        MCTableHandle;
    ctlData:        CtlDataHdl;

BEGIN
    { lock control handle before dereferencing }
    HLock(Handle(theCntl));

    with theCntl^^ do begin
        { set hiliting to titlePart }
        contrlHilite := titlePart;

        { invert the title rect }
        DrawTitle(theCntl);

        { get the pop-up box's rectangle }
        GetBoxRect(theCntl, boxRect);

        { get the topLeft point, and convert to global  }
        SetPt(globalPt, boxRect.left, boxRect.top);
        LocalToGlobal(globalPt);

        { get a handle to the pop-up menu }
        ctlData := CtlDataHdl(contrlData);
        popMenu := ctlData^^.popMenu;

        { determine the default item }
        if (contrlMax = popMenu^^.menuID) then
            default := contrlMin
        else
            default := 1;

        { let the Menu Manager do the hard stuff }
        with globalPt do begin
            menuResult := PopUpMenuSelect(
                            popMenu,
                            v, h + 1, default);
        end;

        { what menu was the selection made from? }
        menuID := HiWord(menuResult);
        menuItem := LoWord(menuResult);

        { was a menu selection made? }
        if ((menuID <> 0) and ((menuID <> contrlMax)
                or (menuItem<>contrlMin))) then begin
            { check the current selection }
            if (BitAnd(vcLong, mCheck) =
                            mCheck) then begin
                { unmark previous selection }
                SetItemMark(
                    GetMHandle(contrlMax),
                    contrlMin,
                    CHR(noMark));

                { mark current selection }
                SetItemMark(
                    GetMHandle(menuID),
                    menuItem,
                    ctlData^^.markChar);
            end;  { if mCheck }

            { update the MenuSelect() results }
            contrlMax := menuID;
            contrlMin := menuItem;

            { redraw the pop-up box }
            { DrawPopBox(theCntl, vcLong); }
        end;  {if selection made }
    end;  { with }

    { unlock control handle before returning }
    HUnlock(Handle(theCntl));
END;  { doAutoTrack }

END.  { PopMenuCDEF.p }